home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / editors / emcs1857 / 1857el~1.zoo / lisp / time.el < prev    next >
Encoding:
Text File  |  1992-02-03  |  3.7 KB  |  104 lines
  1. ;; Display time and load in mode line of Emacs.
  2. ;; Copyright (C) 1985, 1986, 1987, 1990 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 1, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20.  
  21. (defvar display-time-mail-file nil
  22.   "*File name of mail inbox file, for indicating existence of new mail.
  23. Default is system-dependent, and is the same as used by Rmail.")
  24.  
  25. (defvar display-time-process nil)
  26.  
  27. (defvar display-time-interval 60
  28.   "*Seconds between updates of time in the mode line.")
  29.  
  30. (defvar display-time-string nil)
  31.  
  32. (defun display-time ()
  33.   "Display current time and load level in mode line of each buffer.
  34. Updates automatically every minute.
  35. If display-time-day-and-date is non-nil, the current day and date
  36. are displayed as well."
  37.   (interactive)
  38.   (let ((live (and display-time-process
  39.            (eq (process-status display-time-process) 'run))))
  40.     (if (not live)
  41.     (progn
  42.       (if display-time-process
  43.           (delete-process display-time-process))
  44.       (or global-mode-string (setq global-mode-string '("")))
  45.       (or (memq 'display-time-string global-mode-string)
  46.           (setq global-mode-string
  47.             (append global-mode-string '(display-time-string))))
  48.       (setq display-time-string "")
  49.       (setq display-time-process
  50.         (start-process "display-time" nil
  51.                    (concat exec-directory "wakeup")
  52.                    (int-to-string display-time-interval)))
  53.       (process-kill-without-query display-time-process)
  54.       (set-process-sentinel display-time-process 'display-time-sentinel)
  55.       (set-process-filter display-time-process 'display-time-filter)))))
  56.  
  57. (defun display-time-sentinel (proc reason)
  58.   (or (eq (process-status proc) 'run)
  59.       (setq display-time-string ""))
  60.   ;; Force mode-line updates
  61.   (save-excursion (set-buffer (other-buffer)))
  62.   (set-buffer-modified-p (buffer-modified-p))
  63.   (sit-for 0))
  64.  
  65. (defun display-time-filter (proc string)
  66.   (let ((time (current-time-string))
  67.     (load (condition-case ()
  68.           (if (zerop (car (load-average))) ""
  69.             (format "%03d" (car (load-average))))
  70.         (error "")))
  71.     (mail-spool-file (or display-time-mail-file
  72.                  (getenv "MAIL")
  73.                  (concat rmail-spool-directory
  74.                      (or (getenv "LOGNAME")
  75.                      (getenv "USER")
  76.                      (user-login-name)))))
  77.     hour pm)
  78.     (setq hour (read (substring time 11 13)))
  79.     (setq pm (>= hour 12))
  80.     (if (> hour 12)
  81.     (setq hour (- hour 12))
  82.       (if (= hour 0)
  83.       (setq hour 12)))
  84.     (setq display-time-string
  85.       (concat (format "%d" hour) (substring time 13 16)
  86.           (if pm "pm " "am ")
  87.           (if (string= load "")
  88.               ""
  89.             (concat (substring load 0 -2) "." (substring load -2)))
  90.           (if (and (file-exists-p mail-spool-file)
  91.                ;; file not empty?
  92.                (> (nth 7 (file-attributes mail-spool-file)) 0))
  93.               " Mail"
  94.             "")))
  95.     ;; Append the date if desired.
  96.     (if display-time-day-and-date
  97.     (setq display-time-string
  98.           (concat (substring time 0 11) display-time-string))))
  99.   ;; Force redisplay of all buffers' mode lines to be considered.
  100.   (save-excursion (set-buffer (other-buffer)))
  101.   (set-buffer-modified-p (buffer-modified-p))
  102.   ;; Do redisplay right now, if no input pending.
  103.   (sit-for 0))
  104.